home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 23 / super.zip / SUPERCOM.PAS < prev   
Pascal/Delphi Source File  |  1986-06-13  |  12KB  |  414 lines
  1. {                       SUPERCOM
  2.  
  3. Buffered communications support library for Turbo Pascal
  4.  
  5.               (C) Copyright 1986, Doctor Debug, Pittsburgh Pa
  6.                             All Rights Reserved
  7.  
  8. These routines are meant to be called by user programs. The
  9. SUPERCOM.COM Interrupt 14 driver must have been installed to
  10. use any of these routines. Use of these routines without proper
  11. installation of SUPERCOM.COM will produce unpredictable results.
  12.  
  13. The integers InError and OutError will always contain the error
  14. conditions after every receive or transmit. The bits of these
  15. values are defined as:
  16.  
  17.      Bit 7 (128)        Timeout
  18.      Bit 3   (8)        Framing Error
  19.      Bit 2   (4)        Parity Error
  20.      Bit 1   (2)        Overrun Error
  21.  
  22. If the value of InError[port] is 0, then you can be sure that the
  23. last character was received without error.
  24.  
  25. The value or Port is always 1 or 2.
  26.  
  27.      Procedure InitPort(port,Baud,Parity,data_bits,stop_bits)
  28.           Baud: integer 300-9600
  29.           Parity: char, E(ven),O(dd),N(one)
  30.           Data_bits: integer, 7 or 8
  31.           Stop_bits: integer, 1 or 2
  32.  
  33.           This routine initializes the communications port
  34.           to the parameters specified and activates SUPERCOM
  35.           for that port. All of the following functions will
  36.           use the port specified here.
  37.  
  38.      Function PortStatus(port)
  39.  
  40.           This function returns the line status and modem control
  41.           status of the comm port specified. The bits returned are
  42.           defined as:
  43.  
  44.           Bit 15 (negative)  Time out (no device connected)
  45.           Bit 14 (16384)     Transmission shift register empty
  46.           Bit 13 (8192)      Transmission holding register empty
  47.           Bit 12 (4096)      Break detect
  48.           Bit 11 (2048)      Framing error
  49.           Bit 10 (1024)      Parity error
  50.           Bit 9  (512)       Overrun error
  51.           Bit 8  (256)       Data ready
  52.           Bit 7  (128)       Received line signal detect
  53.           Bit 6  (64)        Ring indicator
  54.           Bit 5  (32)        Data set ready
  55.           Bit 4  (16)        Clear to send
  56.           Bit 3  (8)         Delta receive line signal detect
  57.           Bit 2  (4)         Trailing edge ring detector
  58.           Bit 1  (2)         Delta data set ready
  59.           Bit 0  (1)         Delta clear to send
  60.  
  61.      Procedure XmitCh(ch)
  62.  
  63.           This Procedure sends the character in ch out the port
  64.           specified.
  65.  
  66.      Procedure XmitBlk(string)
  67.  
  68.           This procedure sends the entire string out the comm port.
  69.  
  70.      Procedure XmitLn(string)
  71.  
  72.           This is identical to XmitBlk, but adds a CR/LF to the
  73.           end of the block.
  74.  
  75.       Procedure RecCh(ch)
  76.  
  77.           This procedure waits until a character is available over
  78.           the comm line and then returns it in ch. If the system times
  79.           out ch will contain a nul (Ascii 0).
  80.  
  81.      Procedure RecLn(string)
  82.  
  83.           This is the equivalent of ReadLn over the comm port.
  84.           Be sure to check the InError variable to make sure the
  85.           operation did not time out (no CR was received.)
  86.  
  87.      Procedure RecBlk(number,String)
  88.  
  89.           The number of characters specified by number will be
  90.           placed into the string. Be sure to check the InError
  91.           variable to assure that the operation did not time out
  92.           before sufficient characters were received.
  93.  
  94.      Procedure GrabCh(ch)
  95.  
  96.           If a character is waiting in the receive buffer it will
  97.           be returned in ch otherwise ch will contain a nul character.
  98.  
  99.      Procedure PeekBuff(ch)
  100.  
  101.           Identical to GrabCh but the character is not removed
  102.           from the buffer.
  103.  
  104.      Procedure ClearBuff
  105.  
  106.           Empties the receive buffer
  107.  
  108.      Procedure ClosePort
  109.  
  110.           Closes the comm port and deactivates SUPERCOMM until the
  111.           next InitPort.
  112.  
  113.      Function Rlen
  114.  
  115.           Returns the number of characters currently available in the
  116.           receive buffer.
  117.  
  118. *************************************************************************
  119.                    GLOBAL VARIABLES
  120. *************************************************************************
  121. }
  122.  
  123.    Type
  124.       _Register_Set = Record case Integer of
  125.                    1: (AX,BX,CX,DX,BP,DI,SE,DS,ES,Flags: Integer);
  126.                    2: (AL,AH,BL,BH,CL,CH,DL,DH: Byte);
  127.                    End;
  128.       LString = Array [0..1024] of char;
  129.       _Parity = (None,Even,Odd);
  130.  
  131.    Var
  132.       _Regs: _Register_Set;
  133.       InError,OutError:   Byte;
  134.       UsePort: Integer;
  135.  
  136. {***********************************************************************
  137.                             InitPort
  138. ***********************************************************************}
  139.  
  140.    Procedure InitPort(Port,Baud: integer;Par: _parity;D_bits,S_bits: integer);
  141.  
  142.    Var
  143.       Parameter: integer;
  144.  
  145.    Begin
  146.       Case Baud of
  147.          110: Baud := 0;
  148.          150: Baud := 1;
  149.          300: Baud := 2;
  150.          600: Baud := 3;
  151.         1200: Baud := 4;
  152.         2400: Baud := 5;
  153.         4800: Baud := 6;
  154.         Else  Baud := 7; {default to 9600}
  155.       End;
  156.  
  157.       If S_bits=2 then S_bits := 1
  158.          else S_bits := 0; {default 1 stop bit}
  159.  
  160.       If D_bits=7 then D_bits := 2
  161.          else D_bits := 3; {default 8 data bits}
  162.  
  163.       Parameter := (Baud shl 5) + (S_bits shl 2) + D_bits;
  164.       Case Par of
  165.          Odd:  Parameter := Parameter + 8;
  166.          Even: Parameter := Parameter + 24;
  167.          Else; {default no parity}
  168.       End;
  169.  
  170.       With _Regs do
  171.          Begin
  172.             AH := 12;         {Activate SuperCom}
  173.             AL := Parameter;  {set-up parameters}
  174.             DX := Port-1;     {port to use}
  175.             Intr($14,_Regs);  {perform function}
  176.          End;
  177.       UsePort := Port-1;      {Save for later use}
  178.    End; {InitPort}
  179.  
  180. {***************************************************************************
  181.                              Port Status
  182. ***************************************************************************}
  183.  
  184.    Function PortStatus:integer;
  185.    Begin
  186.       With _Regs do
  187.          Begin
  188.             AH := 3;              {Status Request}
  189.             DX := UsePort;
  190.             Intr($14,_Regs);
  191.             PortStatus := AX;
  192.           End;
  193.    End;
  194.  
  195. {**************************************************************************
  196.                              XmitCH
  197. **************************************************************************}
  198.  
  199.    Procedure XmitCh(ch0:char);
  200.    Begin
  201.       with _Regs do
  202.       Begin
  203.          AH := 1;               {Request function 1}
  204.          DX := UsePort;
  205.          AL := Ord(Ch0);         {puts Ascii Value in AL}
  206.          Intr ($14,_Regs);
  207.          OutError := AH;
  208.       End;
  209.    End;
  210.  
  211. {**************************************************************************
  212.                              XmitBlk
  213. **************************************************************************}
  214.  
  215.    Procedure XmitBlk(st:LString);
  216.    Begin
  217.       With _Regs do
  218.       Begin
  219.          DX := UsePort;
  220.          AH := 6;
  221.          CX := ord(st[0]);
  222.          ES := Seg(st[1]);
  223.          BX := Ofs(st[1]);
  224.          Intr($14,_Regs);
  225.          OutError := AH;
  226.       End;
  227.    End;
  228.  
  229. {**************************************************************************
  230.                              XmitLn
  231. **************************************************************************}
  232.  
  233.    Procedure XmitLn(st:lstring);
  234.    Var Ls: Integer;
  235.    Begin
  236.       Ls := Ord(St[0]);
  237.       Ls := Ls + 1;
  238.       St[Ls] := chr(13);
  239.       Ls := Ls + 1;
  240.       St[Ls] := chr(10);
  241.       St[0] := chr(Ls);
  242.       With _Regs do
  243.       Begin
  244.          DX := UsePort;
  245.          AH := 6;
  246.          CX := Ls;
  247.          ES := Seg(st[1]);
  248.          BX := Ofs(st[1]);
  249.          Intr($14,_Regs);
  250.         OutError := AH;
  251.       End;
  252.    End;
  253.  
  254. {**************************************************************************
  255.                              RecCh
  256. **************************************************************************}
  257.  
  258.    Procedure RecCh(var ch1:char);
  259.    Begin
  260.       With _Regs do
  261.       Begin
  262.          DX := UsePort;
  263.          AH := 2;
  264.          Intr($14,_Regs);
  265.          InError := AH;
  266.          ch1 := Chr(AL);
  267.       End;
  268.    End;
  269.  
  270. {**************************************************************************
  271.                                PeekBuff
  272. **************************************************************************}
  273.  
  274.    Procedure PeekBuff(Var Ch2:Char);
  275.    Begin
  276.       With _Regs do
  277.       Begin
  278.          DX := UsePort;
  279.          AH := 14;
  280.          Intr($14,_Regs);
  281.          ch2 := Chr(AL);
  282.          InError := AH;
  283.       End;
  284.    End;
  285.  
  286. {**************************************************************************
  287.                              RecLn
  288. **************************************************************************}
  289.  
  290.    Procedure RecLn(var St1:lstring);
  291.    Var i,TimeOut: integer; ch: char;
  292.    Begin
  293.       i := 0;
  294.       St1[0] := chr(0);
  295.       TimeOut := 0;
  296.       While ((ch <> chr(13)) or (TimeOut <> 1)) do
  297.       Begin
  298.          RecCh(ch);
  299.          If (InError And $80) <> $80 then
  300.             Begin
  301.                i := i + 1;
  302.                St1[i] := Ch;
  303.             End
  304.          else
  305.             TimeOut := 1;
  306.       End; {while}
  307.  
  308.       If (InError and $80) <> $80 then
  309.          Begin
  310.             PeekBuff(Ch);
  311.             If Ch = chr(10) then
  312.                Begin
  313.                   RecCh(Ch);             {Remove LF from receive Buffer}
  314.                   i := i + 1;
  315.                   St1[i] := Ch;
  316.                End; {if}
  317.          End;  {if}
  318.       St1[0] := chr(i);
  319.    End;
  320.  
  321. {***************************************************************************
  322.                              RecBlk
  323. ***************************************************************************}
  324.  
  325.    Procedure RecBlk(Var Lb:Integer; var st2:LString);
  326.    Begin
  327.       With _Regs do
  328.       Begin
  329.          DX := UsePort;
  330.          AH := 5;
  331.          CX := Lb;
  332.          ES := Seg(St2[1]);
  333.          BX := Ofs(St2[1]);
  334.          Intr($14,_Regs);
  335.          InError := AH;
  336.          st2[0]:=chr(Lb);
  337.       End;
  338.    End;
  339.  
  340. {***************************************************************************
  341.                               GrabCh
  342. ***************************************************************************}
  343.  
  344.    Procedure GrabCh(VAr Ch3:Char);
  345.    Begin
  346.       WIth _Regs do
  347.       Begin
  348.          DX := UsePort;
  349.          AH := 8;
  350.          Intr($14,_Regs);
  351.          InError := AH;
  352.          ch3 := chr(AL);
  353.       End;
  354.    End;
  355.  
  356. {**************************************************************************
  357.                               ClearBuff
  358. **************************************************************************}
  359.  
  360.    Procedure ClearBuff;
  361.    Begin
  362.       With _Regs do
  363.       Begin
  364.          DX := UsePort;
  365.          AH := 4;
  366.          Intr($14,_Regs);
  367.       End;
  368.    End;
  369.  
  370. {***************************************************************************
  371.                               ClosePort
  372. ***************************************************************************}
  373.  
  374.    Procedure ClosePort;
  375.    Begin
  376.       WIth _Regs do
  377.       Begin
  378.          DX := UsePort;
  379.          AH := 13;
  380.          Intr($14,_Regs);
  381.       End;
  382.    End;
  383.  
  384. {***************************************************************************
  385.                                RLen
  386. ***************************************************************************}
  387.  
  388.    Function Rlen:Integer;
  389.    Begin
  390.       With _Regs do
  391.       Begin
  392.          DX := UsePort;
  393.          AH := 7;
  394.          Intr($14,_Regs);
  395.          Rlen := AX;
  396.       End;
  397.    End;
  398.  
  399. {***************************************************************************
  400.                               GetKey
  401. ***************************************************************************}
  402.  
  403. {Gets a keypress without echo}
  404.  
  405.    Function GetKey:Char;
  406.    Begin
  407.       With _Regs do
  408.       Begin
  409.          AH := 7;
  410.          MsDos(_Regs);
  411.          GetKey := chr(AL);
  412.       End;
  413.    End;
  414.